home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / twars.arc / OVER.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-28  |  60KB  |  1,983 lines

  1. OVERLAY
  2.  
  3.  
  4. PROCEDURE INIT;
  5.  
  6.   VAR
  7.       L     : INTEGER;
  8.       DONE  : BOOLEAN;
  9.       alias : str;
  10.       piont : integer;
  11.       Ack   : char;
  12. BEGIN
  13.   ASSIGN(MSGER,'tradewar\TWOPENG.DAT');
  14.   RESET(MSGER);
  15.   APPEND(MSGER);
  16.   ASSIGN(teams,'tradewar\twteam.dat');
  17.   RESET(teams);
  18.   ASSIGN(SMG,'tradewar\TWSMF.DAT');
  19.   ENDED := FALSE;
  20.   ASSIGN(USERF,'tradewar\TWDATA.DAT');
  21.   RESET(USERF);
  22.   READIN(1,USERR);
  23.   planets := TRUE;
  24.   ports   := TRUE;
  25.   players := TRUE;
  26.   WITH USERR DO
  27.     BEGIN
  28.       AY := FC;
  29.       TT := FD;
  30.       LP := FE;
  31.       LS := FF;
  32.       LT1 := FG;
  33.       LL1 := FO;
  34.     END;
  35.   GETDATE;
  36.   NL;
  37.   ANSIC(3);
  38.   cls;
  39.   PRINTFILE('tradewar\twhello.msg');
  40.   CLS;
  41.   ANSIC(4);
  42.   PRINTFILE('tradewar\TWOPENG.DAT');
  43.   PAUSESCR;
  44.   APPEND(MSGER);
  45.   cls;
  46.   ANSIC(6);
  47.   NL;
  48.   PRINT('Initializing...');
  49.   PD := D;
  50.   NL;
  51.   PRINT('Welcome '+THISUSER.NAME+'!');
  52.   PRINT('Searching my records for your name.');
  53.   L := 2;
  54.   DONE := FALSE;
  55.   REPEAT
  56.     READIN(L,USERR);
  57.     IF USERR.FAREAL=THISUSER.NAME
  58.       THEN
  59.         BEGIN
  60.           PN := L;
  61.           DONE := TRUE;
  62.         END;
  63.     L := L+1;
  64.   UNTIL DONE OR (L>LP) OR HANGUP;
  65.   IF NOT DONE
  66.     THEN
  67.       BEGIN
  68.         PRINT(
  69.            'I can''t find your record, so I am assuming you are a new trainee.'
  70.         );
  71.         NL;
  72.         PRINT('Entering a new trainee...');
  73.         PN := 2;
  74.         DONE := FALSE;
  75.         REPEAT
  76.           READIN(PN,USERT);
  77.           IF USERT.FM < 1
  78.             THEN
  79.               DONE := TRUE;
  80.           PN := PN+1;
  81.         UNTIL DONE OR (PN>LP);
  82.         PN := PN-1;
  83.         IF NOT DONE
  84.           THEN
  85.             BEGIN
  86.               PRINT('I''m sorry but the game is full.');
  87.               PRINT('Please leave a message for the Emperor so');
  88.               PRINT('he can save a space for you when one opens up.');
  89.               SYSOPLOG(TIME+' '+DATE+' '+THISUSER.NAME+
  90.                        ': New player not allowed - game full.');
  91.               ENDED := TRUE;
  92.             END
  93.           ELSE
  94.             BEGIN
  95.               READIN(1,USERT);
  96.               NL;
  97.               PRINT('Notice: If you don''t play for '+CSTR(USERT.
  98.                     FK)
  99.                  +' days, you will');
  100.               PRINT('be.....removed to make room for someone else.');
  101.               NL;
  102.               alias := '';
  103.               prompt('Do you wish to use an Alias? ');
  104.               if yn then
  105.                  begin
  106.                     prompt('Enter the Alias you want to use ');
  107.                     mpl(41);
  108.                     inputl(alias,41);
  109.                     if alias<>'' then
  110.                        userr.fa := alias;
  111.                  end;
  112.               if alias='' then
  113.                  begin
  114.                     alias := nam;
  115.                     piont := pos('#',alias)-1;
  116.                     DELETE(alias,piont,9);
  117.                  end;
  118.               READIN(PN,USERR);
  119.               USERR.FA := ALIAS;
  120.               USERR.FAREAL := THISUSER.NAME;
  121.               USERR.FM := LENGTH(alias);
  122.               USERR.FR := 0;
  123.               WRITEOUT(PN,USERR);
  124.               SYSOPLOG(TIME+' '+DATE+' '+USERR.FAREAL+
  125.                        '('+CSTR(PN)+'): New Player on Trade Wars');
  126.               SYSOPLOG('Under the assumed name of '+userr.fa);
  127.               INITSHIP;
  128.             END;
  129.       END
  130.     ELSE
  131.       BEGIN
  132.         PNN := USERR.FA;
  133.         NL;
  134.         SYSOPLOG(TIME+' '+DATE+' '+PNN+'('+CSTR(PN)+'): Tradewars.');
  135.         READIN(PN,USERR);
  136.         if userr.fr <> 0 then
  137.         begin
  138.           SEEK(teams,userr.fr);
  139.           read(teams,rteams);
  140.         end;
  141.         A := USERR.FB;
  142.         DONE := FALSE;
  143.         IF A>PD
  144.           THEN
  145.             BEGIN
  146.               PRINT('You won''t be allowed on for another '+CSTR(A-PD)+' day(s)!');
  147.               ENDED := TRUE;
  148.             END;
  149.         IF ((A=PD) AND (USERR.FC<>-99))
  150.           THEN
  151.             BEGIN
  152.               ANSIC(6);
  153.               PRINT('You have been on today.');
  154.               IF USERR.FD<1
  155.                 THEN
  156.                   BEGIN
  157.                     ANSIC(8);
  158.                     PRINT('You don''t have any turns left today.'+
  159.                           ' You will be allowed to play tomorrow.');
  160.                     ENDED := TRUE;
  161.                     ANSIC(1);
  162.                   END;
  163.               IF USERR.FC=PN
  164.                 THEN
  165.                   BEGIN
  166.                     PRINT('Oi Vey!! You killed yourself today! Maybe you will be allowed on tomorrow');
  167.                     ENDED := TRUE;
  168.                   END;
  169.             END;
  170.         IF (A<PD) OR ((A=PD) AND (NOT ENDED) AND (USERR.FC<>99))
  171.           THEN
  172.             BEGIN
  173.               READMSG;
  174.               IF (USERR.FC=0) OR (USERR.FC=-75)
  175.                 THEN
  176.                   BEGIN
  177.                     IF (USERR.FD<=TT) AND (USERR.FB<PD)
  178.                       THEN
  179.                         BEGIN
  180.                           USERR.FD := TT;
  181.                           USERR.FB := PD;
  182.                           WRITEOUT(PN,USERR);
  183.                         END;
  184.                     DONE := TRUE;
  185.                     NL;
  186.                     PRINT('You have '+CSTR(USERR.FD)+' turns this Stardate.');
  187.                   END;
  188.             END;
  189.         IF (NOT ENDED) AND (NOT DONE)
  190.           THEN
  191.             BEGIN
  192.               A := USERR.FC;
  193.               IF A=-99
  194.                 THEN
  195.                   INITSHIP
  196.                 ELSE
  197.                   BEGIN
  198.                     IF A=-98
  199.                       THEN
  200.                         PRINT('You have been destroyed by a person '+
  201.                                  'who has been...removed from the game.');
  202.                     IF A=-1
  203.                       THEN
  204.                         PRINT('You have been ambushed by the Ferrengi!');
  205.                     IF A=PN
  206.                       THEN
  207.                         BEGIN
  208.                           NL;
  209.                           PRINT(
  210.                        'You managed to Q''est'' yourself on your last time on.'
  211.                           );
  212.                         END;
  213.                     IF (A>1) AND (A<=LP)
  214.                       THEN
  215.                         BEGIN
  216.                           READIN(A,USERT);
  217.                           PRINT(USERT.FA+' destroyed your ship!');
  218.                         END;
  219.                     INITSHIP;
  220.                   END;
  221.             END;
  222.       END;
  223. END;
  224.  
  225. OVERLAY
  226.  
  227. PROCEDURE COMPUTER;
  228.  
  229.   VAR
  230.       PRR,S2,N : INTEGER;
  231.       I        : STR;
  232.  
  233.   PROCEDURE FINDSEC(PRR:INTEGER);
  234.  
  235.     VAR
  236.         A,B,SUD   : INTEGER;
  237.         I : STR;
  238.   BEGIN
  239.     A := PRR;
  240.     PROMPT('What sector do you want to get to? ');
  241.     INPUT(I,4);
  242.     IF I<>''
  243.       THEN
  244.         BEGIN
  245.           B := VALUE(I);
  246.           IF (B<1) OR (B>LS-LP)
  247.             THEN
  248.               PRINT('Valid sector numbers are from 1 to '+CSTR(LS-LP)+'.')
  249.             ELSE
  250.               IF A=B
  251.                 THEN
  252.                   PRINT('You are already in that sector!')
  253.                 ELSE
  254.                   BEGIN
  255.                     NL;
  256.                     PRINT('Computing shortest path...');
  257.                     SHORTEST(A,B);
  258.                     IF S[A,1]=0
  259.                       THEN
  260.                         PRINT(
  261.                            'There was an error in computation between sectors.'
  262.                         )
  263.                       ELSE
  264.                         BEGIN
  265.                           NL;
  266.                           PRINT('The shortest path from sector '
  267.                                 +CSTR(A)+' to sector '+CSTR(B)+' is:');
  268.                           PROMPT(CSTR(A));
  269.                           SUD := A;
  270.                           REPEAT
  271.                             SUD := S[SUD,1];
  272.                             IF SUD<>0
  273.                               THEN
  274.                                 PROMPT(' > '+CSTR(SUD))
  275.                               ELSE
  276.                                 NL;
  277.                           UNTIL SUD=0;
  278.                           READIN(LP+PRR,USERT);
  279.                           E[1] := USERT.FB;
  280.                           E[2] := USERT.FC;
  281.                           E[3] := USERT.FD;
  282.                           E[4] := USERT.FE;
  283.                           E[5] := USERT.FF;
  284.                           E[6] := USERT.FG
  285.                         END;
  286.                   END;
  287.         END;
  288.   END;
  289.  
  290.  
  291.   PROCEDURE SNDMSSG;
  292.  
  293.    VAR
  294.       PID,PPTR    : INTEGER;
  295.       MESSAGE1    : STRING[160];
  296.       SCANSTRING  : STRING[41];
  297.       PFOUND      : BOOLEAN;
  298.       ANSWER      : STRING[2];
  299.       USERZ       : USERS;
  300.  
  301.    BEGIN
  302.        ANSWER := 'N';
  303.        NL;
  304.        ANSIC(3);
  305.        PROMPT('Enter part of name to search for - ');
  306.        MPL(41);
  307.        INPUTL(SCANSTRING,41);
  308.        IF (scanstring <> '') then
  309.         begin
  310.           PPTR := 2;
  311.           PID  := 0;
  312.           PFOUND := FALSE;
  313.           REPEAT
  314.              READIN(PPTR,USERZ);
  315.              IF (POS(SCANSTRING,USERZ.FA)>0) AND (USERZ.FM>0) THEN
  316.              BEGIN
  317.                 ANSIC(4);
  318.                 PROMPT('Send to '+USERZ.FA+'? ');
  319.                 IF yn THEN
  320.                 BEGIN
  321.                    SSM(PPTR,'Hyperspace message received from '+userr.fa+':');
  322.                    PROMPT('Enter message [160 chars]');
  323.                    NL;
  324.                    INPUTL(MESSAGE1,160);
  325.                    SSM(PPTR,MESSAGE1);
  326.                    SSM(PPTR,' ');
  327.                    prompt('Transmission sent');
  328.                    nl;
  329.                    PFOUND := TRUE;
  330.                 END;
  331.              END;
  332.              PPTR := PPTR + 1;
  333.           UNTIL PFOUND OR HANGUP OR (PPTR >= LP);
  334.         end;
  335.     IF (ANSWER='N') AND (PPTR >= LP) THEN
  336.       BEGIN
  337.         ANSIC(8);
  338.         PROMPT('Name not found!');
  339.       END;
  340.  END;
  341.  
  342.  
  343.  PROCEDURE REPORTSEC(S2:INTEGER);
  344.  
  345.     VAR
  346.         I: STR;
  347.         A,P: INTEGER;
  348.   BEGIN
  349.     PROMPT('What sector is the port in? ['+cstr(prr)+'] ');
  350.     INPUT(I,4);
  351.         BEGIN
  352.           if (I='') then a := prr
  353.           else  A := VALUE(I);
  354.           IF (A<1) OR (A>LS-LP)
  355.             THEN
  356.               PRINT('The Empire only possesses sectors 1 to '+CSTR(LS-LP)+'.')
  357.             ELSE
  358.               BEGIN
  359.                 READIN(LP+A,USERT);
  360.                 P := USERT.FH;
  361.                 IF (P=0) OR ( ((USERT.FL>0) AND (USERT.FM<>PN)) AND
  362.                               ((userr.fr>0) AND ((-1*(usert.fm+10))<>userr.fr)) )
  363.                   THEN
  364.                     BEGIN
  365.                       NL;
  366.                       PRINT('I have no information about that port.');
  367.                     END
  368.                   ELSE
  369.                     IF (P <> 1) AND (P <> 153) AND (P <> 154)
  370.                       THEN
  371.                         BEGIN
  372.                           UPPORT(LP+A);
  373.                           OTHERPORT(P+LS);
  374.                         END
  375.                       ELSE
  376.                         PORT1;
  377.               END;
  378.         END;
  379.   END;
  380.  
  381.  
  382.   PROCEDURE RANKINGS;
  383.  
  384.     VAR
  385.         P,R        : INTEGER;
  386.         ABORT,NEXT : BOOLEAN;
  387.         temy       : str;
  388.   BEGIN
  389.     cls;
  390.     ANSIC(8);
  391.     NL;
  392.     PRINT('Ranking players...');
  393.     RANK(P);
  394.     cls;
  395.     ansic(3);
  396.     PRINT('Player Rankings: '+DATE+' '+TIME);
  397.     NL;
  398.     ANSIC(5);
  399.     PRINT('Rank     Value       Team    Player   ');
  400.     ANSIC(2);
  401.     PRINT('~~~~  ~~~~~~~~~~~~ ~~~~~~~~ ~~~~~~~~ ');
  402.     R := 1;
  403.     ANSIC(1);
  404.     ABORT := FALSE;
  405.     REPEAT
  406.       READIN(P,USERT);
  407.       if r = 1 then ansic(6);
  408.       if p = pn then ansic(6);
  409.       if usert.fr <> 0 then
  410.         begin
  411.           temy := '  ['+addblank(cstr(usert.fr),2)+']  ';
  412.         end
  413.       else temy := 'Indpndnt';
  414.       if usert.fv > 0 then
  415.       PRINTACR(ADDBLANK(CSTR(R),4)+ADDBLANK(CSTR(USERT.FV),14)
  416.                +' '+temy+' '+USERT.FA,ABORT,NEXT)
  417.       else
  418.       PRINTACR(ADDBLANK(CSTR(R),4)+'          Dead'
  419.                +' '+temy+' '+USERT.FA,ABORT,NEXT);
  420.  
  421.       P := USERT.FT;
  422.       R := R+1;
  423.     UNTIL (P=-1) OR ABORT;
  424.   END;
  425.  
  426. BEGIN
  427.   cls;
  428.   ANSIC(8);
  429.   PRINT('<Computer>');
  430.   NL;
  431.   ANSIC(2);
  432.   PRINT('<Computer activated>');
  433.   ANSIC(1);
  434.   DONE := FALSE;
  435.   READIN(PN,USERR);
  436.   PRR := USERR.FF;
  437.   S2 := PRR+LP;
  438.   WHILE (NOT HANGUP) AND (NOT DONE) DO
  439.     BEGIN
  440.       DUMP;
  441.       TLEFT;
  442.       NL;
  443.       PROMPT('Computer command (?=Help)? ');
  444.       MMKEY(I);
  445.       IF I=''
  446.         THEN
  447.           PRINT('? = Help');
  448.       CASE I[1] OF
  449.         'Q','q','1' : DONE := TRUE;
  450.         'P','p','2' : REPORTSEC(S2);
  451.         'F','f','3' : FINDSEC(PRR);
  452.         'R','r','4' : RANKINGS;
  453.         'S','s','5' : SNDMSSG;
  454.         'V','v','6' : PRINTFILE('tradewar\twmap.msg');
  455.         'T','t','7' : BEGIN
  456.                         NL;
  457.                         ANSIC(4);
  458.                         PRINT(DAT);
  459.                         NL;
  460.                       END;
  461.        ELSE           PRINTFILE('tradewar\twcmenu.msg');
  462.       END;
  463.     END;
  464.   NL;
  465.   PRINT('<Computer deactivated>');
  466. END;
  467.  
  468. OVERLAY
  469.  
  470. PROCEDURE PORT;
  471.  
  472.   VAR
  473.       ST,R,P2,F2,L2,A           : INTEGER;
  474.       DONEIT                    : BOOLEAN;
  475.       M2,NUH,C2                 : REAL;
  476.  
  477. PROCEDURE IDUNNO;
  478. BEGIN
  479.   READIN(P2,USERT);
  480.   IF L2=1
  481.     THEN
  482.       USERT.FD := TRUNC(N[1]-NUH)
  483.     ELSE
  484.       IF L2=2
  485.         THEN
  486.           USERT.FE := TRUNC(N[2]-NUH)
  487.         ELSE
  488.           USERT.FF := TRUNC(N[3]-NUH);
  489.   WRITEOUT(P2,USERT);
  490. END;
  491.  
  492. PROCEDURE DUNNO2;
  493.  
  494.   VAR
  495.       S : INTEGER;
  496. BEGIN
  497.   s := SGN(TRUNC(C1[L2]));
  498.   USERR.credits := M2-s*A;
  499.   IF L2=1
  500.     THEN
  501.       USERR.FI := TRUNC(H[1]+S*NUH)
  502.     ELSE
  503.       IF L2=2
  504.         THEN
  505.           USERR.FJ := TRUNC(H[2]+S*NUH)
  506.         ELSE
  507.           USERR.FK := TRUNC(H[3]+S*NUH);
  508.   WRITEOUT(PN,USERR);
  509.   IDUNNO;
  510.   H[L2] := H[L2]+S*trunc(NUH);
  511. END;
  512.  
  513. PROCEDURE TRADE(L2:INTEGER);
  514.  
  515.   VAR
  516.       V,HUH,B   : INTEGER;
  517.       MUH       : REAL;
  518.       DIM,EIM,I : STR;
  519. BEGIN
  520.   M2 := USERR.credits;
  521.   HUH := TRUNC(H[0]-H[1]-H[2]-H[3]);
  522.   IF C1[L2]>0
  523.     THEN
  524.       BEGIN
  525.         DIM := 'buy';
  526.         EIM := 'sell';
  527.         B := -1;
  528.       END
  529.               ELSE
  530.                 BEGIN
  531.                   DIM := 'sell';
  532.                   EIM := 'buy' ;
  533.                   B := 0;
  534.                 END;
  535.   IF B=-1
  536.     THEN
  537.       BEGIN
  538.         MUH := HUH;
  539.         IF trunc(MUH) > N[L2]
  540.           THEN
  541.             MUH := N[L2];
  542.       END;
  543.   IF B=-1
  544.     THEN
  545.       BEGIN
  546.         IF MUH*M[L2] > M2
  547.           THEN
  548.             MUH := M2/M[L2]
  549.       END;
  550.   IF B=0
  551.     THEN
  552.       BEGIN
  553.         MUH := N[L2];
  554.         IF MUH>TRUNC(H[L2])
  555.           THEN
  556.             MUH := TRUNC(H[L2]);
  557.       END;
  558.   IF MUH<>0
  559.     THEN
  560.       BEGIN
  561.         DONE := FALSE;
  562.         REPEAT
  563.           NL;
  564.           PRINT('You have '+CSTRR(M2,10)+' credits and '+CSTR(HUH)+
  565.           ' empty cargo holds.');
  566.           NL;
  567.           PRINT('We are '+EIM+'ing up to '+CSTR(ROUND(N[L2]))+
  568.                 '.  You have '+CSTR(ROUND(H[L2]))+' in your holds.');
  569.           F2 := 1;
  570.           PROMPT('How many holds of ');
  571.           IF L2=1
  572.             THEN
  573.               PROMPT('Ore')
  574.             ELSE
  575.               IF L2=2
  576.                 THEN
  577.                   PROMPT('Organics')
  578.                 ELSE
  579.                   PROMPT('Equipment');
  580.           PROMPT(' do you want to '+DIM+' ['+CSTRR(MUH,10)+']? ');
  581.           INPUT(I,4);
  582.           IF I=''
  583.             THEN
  584.              NUH := MUH
  585.             ELSE
  586.               NUH := VALUE(I);
  587.           IF NUH=0
  588.             THEN
  589.               DONE := TRUE;
  590.           IF NUH>=1
  591.             THEN
  592.               IF (B=-1) AND (NUH>HUH)
  593.                 THEN
  594.                   PRINT('You don''t have enough cargo holds.')
  595.                 ELSE
  596.                   IF (B=-1) AND (trunc(NUH)>N[L2])
  597.                     THEN
  598.                       PRINT('They''re not selling that many.')
  599.                     ELSE
  600.                       IF (B=0) AND (trunc(NUH)>N[L2])
  601.                         THEN
  602.                           PRINT('They don''t want that many.')
  603.                         ELSE
  604.                           IF (B=0) AND (trunc(NUH)>H[L2])
  605.                             THEN
  606.                               PRINT('You don''t have that many in your holds.')
  607.                             ELSE
  608.                               DONE := TRUE;
  609.         UNTIL HANGUP OR DONE;
  610.         IF (NUH>=1) AND (NOT HANGUP)
  611.           THEN
  612.             BEGIN
  613.               PRINT('Agreed, '+CSTRR(NUH,10)+' units.');
  614.               V := RANDOM(3)+1;
  615.               R := 1;
  616.               DONEIT := FALSE;
  617.               REPEAT
  618.                 NL;
  619.                 IF R=V+1
  620.                   THEN
  621.                     PROMPT('Our final offer is ')
  622.                   ELSE
  623.                     IF B=-1
  624.                       THEN
  625.                         PROMPT('We''ll sell them for ')
  626.                       ELSE
  627.                         PROMPT('We''ll buy them for ');
  628.                 PRINT(CSTR(TRUNC(NUH*M[L2]*(1+C1[L2]/1000)+0.5))+' credits.');
  629.                 REPEAT
  630.                   DONE := TRUE;
  631.                   PROMPT('Your offer? ');
  632.                   INPUT(I,5);
  633.                   A := VALUE(I);
  634.                   IF (A<M[L2]*trunc(NUH)/10) OR (A>M[L2]*trunc(NUH)*10)
  635.                     THEN
  636.                       BEGIN
  637.                         NL;
  638.                         PRINT('Imperial Intelligence frowns upon those who are'
  639.                         );
  640.                         PRINT('too flippant. Make a SERIOUS offer...');
  641.                         DONE := FALSE;
  642.                       END;
  643.                   IF (A>M2) AND (B=-1)
  644.                     THEN
  645.                       BEGIN
  646.                         PRINT('  You only have '+CSTRR(M2,10)+' credits!');
  647.                         DONE := FALSE;
  648.                       END;
  649.                 UNTIL HANGUP OR DONE;
  650.                 IF (B=0) AND (A<=M[L2]*trunc(NUH))
  651.                   THEN
  652.                     BEGIN
  653.                       ANSIC(8);
  654.                       PRINT('Agreed! We''ll PURCHASE them!');
  655.                       ANSIC(1);
  656.                       DUNNO2;
  657.                       DONEIT := TRUE;
  658.                     END
  659.                   ELSE
  660.                     IF (B=-1) AND (A>=M[L2]*trunc(NUH))
  661.                       THEN
  662.                         BEGIN
  663.                           ANSIC(8);
  664.                           PRINT('Sold!');
  665.                           ANSIC(1);
  666.                           DUNNO2;
  667.                           DONEIT := TRUE;
  668.                         END
  669.                       ELSE
  670.                         BEGIN
  671.                           T := TRUNC(NUH*M[L2]*(1-C1[L2]/250/R)+0.5);
  672.                           IF (B=0) AND (A>T)
  673.                             THEN
  674.                               BEGIN
  675.                                 IDUNNO;
  676.                                 ANSIC(7);
  677.                                 PRINT(
  678.                                'Too high.  We''ll buy them from Orion Traders.'
  679.                                 );
  680.                                 ANSIC(1);
  681.                                 DONEIT := TRUE;
  682.                               END
  683.                             ELSE
  684.                               IF (B=-1) AND (A<T)
  685.                                 THEN
  686.                                   BEGIN
  687.                                     IDUNNO;
  688.                                     ANSIC(6);
  689.                                     NL;
  690.                                     PRINT(
  691.                                'Too low.  We''ll scalp them to the Federation.'
  692.                                     );
  693.                                     ANSIC(1);
  694.                                     DONEIT := TRUE;
  695.                                   END;
  696.                           M[L2] := 0.7*M[L2]+0.3*A/trunc(NUH);
  697.                         END;
  698.                 R := R+1;
  699.               UNTIL HANGUP OR DONEIT OR (R>V+1);
  700.             END;
  701.       END;
  702. END;
  703.  
  704. BEGIN
  705.   ANSIC(8);
  706.   PRINT('<Port>');
  707.   ANSIC(3);
  708.   NL;
  709.   PRINT('Docking...');
  710.   ANSIC(1);
  711.   A := USERR.FD;
  712.   IF A<1
  713.     THEN
  714.       BEGIN
  715.         ANSIC(8);
  716.         PRINT('You don''t have any turns left.');
  717.         ANSIC(1);
  718.       END
  719.     ELSE
  720.       BEGIN
  721.         READIN(S2,USERT);
  722.         ST := USERT.FH;
  723.         P2 := ST+LS;
  724.         IF ST=0
  725.           THEN
  726.             BEGIN
  727.               ANSIC(5);
  728.               PRINT('There are no ports in this sector.');
  729.               ANSIC(1);
  730.             END
  731.           ELSE
  732.             BEGIN
  733.               USERR.FD := A-1;
  734.               WRITEOUT(PN,USERR);
  735.               ANSIC(6);
  736.               PRINT('One turn deducted');
  737.               ANSIC(1);
  738.               READIN(P2,USERT);
  739.               IF (PRR<>1) and (PRR <> 689) and (PRR <> 754)
  740.                 THEN
  741.                   BEGIN
  742.                     UPPORT(USERR.FF+LP);
  743.                     H[0] := USERR.FH;
  744.                     H[1] := USERR.FI;
  745.                     H[2] := USERR.FJ;
  746.                     H[3] := USERR.FK;
  747.                     OTHERPORT(P2);
  748.                     NL;
  749.                     F2 := 0;
  750.                     FOR L2:=1 TO 3 DO
  751.                       IF C1[L2]<0
  752.                         THEN
  753.                           TRADE(L2);
  754.                     FOR L2:=1 TO 3 DO
  755.                       IF C1[L2]>0
  756.                         THEN
  757.                           TRADE(L2);
  758.                     IF F2=0
  759.                       THEN
  760.                         PRINT('You don''t have anything they want,'
  761.                               +' and they don''t have anything you can buy');
  762.                     NL;
  763.                     PRINT('You have '+CSTRR(USERR.credits,10)+' credits and '+
  764.                     CSTR(TRUNC(H[0]-H[1]-H[2]-H[3]))+' empty cargo holds.');
  765.                   END
  766.                 ELSE
  767.                   BEGIN
  768.                     PORT1;
  769.                     C2 := USERR.credits;
  770.                     PRINT('You have '+CSTRR(C2,10)+' credits.');
  771.                     NL;
  772.                     REPEAT
  773.                       DONE := TRUE;
  774.                       PROMPT('How many holds do you want to buy [0]? ');
  775.                       INPUT(I,2);
  776.                       A := TRUNC(VALUE(I));
  777.                       IF A<0
  778.                         THEN
  779.                           DONE := FALSE;
  780.                       IF M[1]*A>C2
  781.                         THEN
  782.                           BEGIN
  783.                             ANSIC(4);
  784.                             PRINT('You don''t have enough money. '+
  785.                                   'The maximum amount you can buy is '+CSTRR(
  786.                                   C2/M[1],10)+'.');
  787.                             ANSIC(1);
  788.                             DONE := FALSE;
  789.                           END;
  790.                       IF A+USERR.FH>75
  791.                         THEN
  792.                           BEGIN
  793.                             ANSIC(8);
  794.                             PRINT('You are limited to 75 cargo holds.');
  795.                             ANSIC(1);
  796.                             DONE := FALSE;
  797.                           END;
  798.                     UNTIL HANGUP OR DONE;
  799.                     USERR.FH := USERR.FH+A;
  800.                     C2 := C2-(M[1]*A);
  801.                     USERR.credits := C2;
  802.                     WRITEOUT(PN,USERR);
  803.                     PRINT('You have '+CSTRR(C2,10)+' credits.');
  804.                     NL;
  805.  
  806.                     REPEAT
  807.                       DONE := TRUE;
  808.                       PROMPT('How many K-3A fighters do you want to buy [0]? ')
  809.                       ;
  810.                       INPUT(I,3);
  811.                       A := TRUNC(VALUE(I));
  812.                       IF A<0
  813.                         THEN
  814.                           DONE := FALSE;
  815.                       IF M[2]*A>C2
  816.                         THEN
  817.                           BEGIN
  818.                             ANSIC(3);
  819.                             PRINT('You don''t have enough money. '+
  820.                                   'The most you can buy is '+CSTRR(C2/M[2],10)+'.');
  821.                             ANSIC(1);
  822.                             DONE := FALSE;
  823.                           END;
  824.                       IF A+USERR.FG>9999
  825.                         THEN
  826.                           BEGIN
  827.                             ANSIC(8);
  828.                             PRINT('Your squadron is limited to 9999 fighters.')
  829.                             ;
  830.                             ANSIC(1);
  831.                             DONE := FALSE;
  832.                           END;
  833.                     UNTIL HANGUP OR DONE;
  834.                     USERR.FG := USERR.FG+A;
  835.                     C2 := C2-(M[2]*A);
  836.                     USERR.credits := C2;
  837.                     WRITEOUT(PN,USERR);
  838.                     PRINT('You have '+CSTRR(C2,10)+' credits.');
  839.                     NL;
  840.                     REPEAT
  841.                       DONE := TRUE;
  842.                       PROMPT('How many shield armor points do you want to buy [0]? ')
  843.                       ;
  844.                       INPUT(I,3);
  845.                       A := TRUNC(VALUE(I));
  846.                       IF A<0
  847.                         THEN
  848.                           DONE := FALSE;
  849.                       IF M[3]*A>C2
  850.                         THEN
  851.                           BEGIN
  852.                             ANSIC(3);
  853.                             PRINT('You don''t have enough money. '+
  854.                                   'The most you can buy is '+CSTR(TRUNC(C2/M[3]))+'.');
  855.                             ANSIC(1);
  856.                             DONE := FALSE;
  857.                           END;
  858.                       IF A+USERR.FE>200
  859.                         THEN
  860.                           BEGIN
  861.                             ANSIC(8);
  862.                             PRINT('Your ship is structurally limited to 200 shield points.')
  863.                             ;
  864.                             ANSIC(1);
  865.                             DONE := FALSE;
  866.                           END;
  867.                     UNTIL HANGUP OR DONE;
  868.                     USERR.FE := USERR.FE+A;
  869.                     C2 := C2-(M[3]*A);
  870.                     USERR.credits := C2;
  871.                     WRITEOUT(PN,USERR);
  872.                     PRINT('You have '+CSTRR(C2,10)+' credits.');
  873.                     NL;
  874.                     REPEAT
  875.                       DONE := TRUE;
  876.                       PROMPT('How many turns do you want to buy [0]? ');
  877.                       INPUT(I,2);
  878.                       A := TRUNC(VALUE(I));
  879.                       IF A<0
  880.                         THEN
  881.                           DONE := FALSE;
  882.                       IF 300*A>C2
  883.                         THEN
  884.                           BEGIN
  885.                             ANSIC(2);
  886.                             PRINT('You don''t have enough money. '+
  887.                                   'The most you can buy is '+CSTR(TRUNC(C2/300)
  888.                             )+'.');
  889.                             ANSIC(1);
  890.                             DONE := FALSE;
  891.                           END;
  892.                     UNTIL DONE OR HANGUP;
  893.                     USERR.FD := USERR.FD+A;
  894.                     C2 := C2-300*A;
  895.                     USERR.credits := C2;
  896.                     WRITEOUT(PN,USERR);
  897.                     PRINT('You have '+CSTRR(C2,10)+' credits.');
  898.                     NL;
  899.                   END;
  900.             END;
  901.       END;
  902. END;
  903.  
  904. OVERLAY
  905.  
  906. PROCEDURE KILL;
  907.  
  908.   type
  909.       string160 = string[160];
  910.  
  911.   VAR
  912.       counter,
  913.       P,N,E2,
  914.       E3,F2,L1,
  915.       LA,K1,ki1  : INTEGER;
  916.       I          : STR;
  917.       bonus      : integer;
  918.       boggey     : integer;
  919.       dest       : integer;
  920.       oathtext   : string160;
  921.       fexit      : boolean;
  922.       userd,
  923.       usery      : users;
  924.  
  925. procedure makeoath(var name1,name2 : str;var result:string160);
  926.  
  927. type
  928.     narf = text;
  929. var
  930.     testline         : string160;
  931.     point,num_to_use,
  932.     loop,pickone     : integer;
  933.     arf              : narf;
  934. begin
  935.    assign(arf,'tradewar\oathtext.dat'); reset(arf);
  936.    readln(arf,num_to_use);
  937.    pickone := random(num_to_use);
  938.    for loop := 1 to pickone do readln(arf);
  939.    if not eof(arf) then begin
  940.       readln(arf,testline);
  941.       if pos('@',testline)>0 then begin
  942.          point := pos('@',testline);
  943.          delete(testline,point,1);
  944.          insert(name1,testline,point);
  945.       end;
  946.       if pos('#',testline)>0 then begin
  947.          point := pos('#',testline);
  948.          delete(testline,point,1);
  949.          insert(name2,testline,point);
  950.       end;
  951.       result := testline;
  952.    end;
  953.    close(arf);
  954. end;
  955.  
  956.  
  957. PROCEDURE rship(p:INTEGER);
  958.  
  959.   VAR
  960.       r,b  : INTEGER;
  961.       done : BOOLEAN;
  962.       usera: users;
  963. BEGIN
  964.   readin(p,usera);
  965.   r := usera.ff;
  966.   IF r<>0 THEN
  967.       BEGIN
  968.         readin(lp+r,usera);
  969.         a := usera.fi;
  970.         IF a<>0 THEN
  971.             IF a=p THEN
  972.               BEGIN
  973.                 readin(a,usera);
  974.                 b := usera.fo;
  975.                 readin(lp+r,usera);
  976.                 usera.fi := b;
  977.                 writeout(lp+r,usera);
  978.               END
  979.             ELSE
  980.               BEGIN
  981.                 done := FALSE;
  982.                 readin(a,usera);
  983.                 REPEAT
  984.                   IF usera.fo = p THEN
  985.                     BEGIN
  986.                       b := a;
  987.                       done := TRUE;
  988.                     END;
  989.                   a := usera.fo;
  990.                   readin(a,usera);
  991.                 UNTIL done;
  992.  
  993.                 a := usera.fo;
  994.                 readin(b,usera);
  995.                 usera.fo := a;
  996.                 writeout(b,usera);
  997.               END;
  998.       END;
  999. END;
  1000.  
  1001.  
  1002. PROCEDURE aship(p:INTEGER);
  1003.  
  1004.   VAR
  1005.       r,b  : INTEGER;
  1006.       done : BOOLEAN;
  1007.       userx: users;
  1008. BEGIN
  1009.   readin(p,usery);
  1010.   r := usery.ff;
  1011.   IF r<>0
  1012.     THEN
  1013.       BEGIN
  1014.         readin(lp+r,userx);
  1015.         b := userx.fi;
  1016.         userx.fi := p;
  1017.         writeout(lp+r,userx);
  1018.         usery.fo := b;
  1019.         writeout(p,usery);
  1020.       END;
  1021. END;
  1022.  
  1023.  
  1024.  
  1025.  
  1026. PROCEDURE SALVAGE(PN,P:INTEGER);
  1027.  
  1028.   VAR
  1029.       B,C,D,E,F,G,H,I,L,V : INTEGER;
  1030.       userq : users;
  1031. BEGIN
  1032.   READIN(P,USERT);
  1033.   readin(prr+lp,userq);
  1034.   A := trunc((medalpts-userr.fg)/100);
  1035.   if (a < 0) or (userq.fl > 0) then a:=0;
  1036.   if (userr.fr > 0) and (a > 0) then
  1037.     begin
  1038.       ansic(8);
  1039.       print('Your Team received '+cstr(a)+' Combat Medals for that!');
  1040.       seek(teams,userr.fr);
  1041.       read(teams,tteams);
  1042.       tteams.kills := tteams.kills + A;
  1043.       seek(teams,userr.fr);
  1044.       write(teams,tteams);
  1045.     end;
  1046.   if usert.credits > 0 then
  1047.     if random(5)<>0 then
  1048.       begin
  1049.         ansic(8);
  1050.         print('You find '+usert.fa+'''s safe containing '+cstrr(usert.credits,10)+' credits!');
  1051.         userr.credits := userr.credits + usert.credits;
  1052.       end;
  1053.   A := TRUNC(USERT.FH/4)+1;
  1054.   IF A+USERR.FH>75
  1055.     THEN
  1056.       A := 75-USERR.FH;
  1057.   IF A<1
  1058.     THEN
  1059.       BEGIN
  1060.         ANSIC(5);
  1061.         PRINT('Excellent kill!');
  1062.         ANSIC(3);
  1063.         PRINT('...In fact, TOO excellent! You can''t salvage anything from it!'
  1064.         );
  1065.       END
  1066.     ELSE
  1067.       BEGIN
  1068.         B := 0;
  1069.         C := 0;
  1070.         D := 0;
  1071.         E := 0;
  1072.         F := USERT.FI;
  1073.         G := USERT.FJ;
  1074.         H := USERT.FK;
  1075.         I := USERT.FH;
  1076.         FOR L:=1 TO A DO
  1077.           BEGIN
  1078.             V := RANDOM(I);
  1079.             IF V<F
  1080.               THEN
  1081.                 BEGIN
  1082.                   B := B+1;
  1083.                   F := F-1
  1084.                 END
  1085.               ELSE
  1086.                 IF V<F+G
  1087.                   THEN
  1088.                     BEGIN
  1089.                       C := C+1;
  1090.                       G := G-1;
  1091.                     END
  1092.                   ELSE
  1093.                     IF V<F+G+H
  1094.                       THEN
  1095.                         BEGIN
  1096.                           D := D+1;
  1097.                           H := H-1
  1098.                         END
  1099.                       ELSE
  1100.                         E := E+1;
  1101.             I := I-1;
  1102.           END;
  1103.         USERR.FH := USERR.FH+B+C+D+E;
  1104.         USERR.FI := USERR.FI+B;
  1105.         USERR.FJ := USERR.FJ+C;
  1106.         USERR.FK := USERR.FK+D;
  1107.         WRITEOUT(PN,USERR);
  1108.         PRINT('You destroyed the ship and salvaged these cargo holds:');
  1109.         IF E>0
  1110.           THEN
  1111.             PRINT('   '+CSTR(E)+' empty');
  1112.         IF B<>0
  1113.           THEN
  1114.             PRINT('   '+CSTR(B)+' with ore');
  1115.         IF C<>0
  1116.           THEN
  1117.             PRINT('   '+CSTR(C)+' with organics');
  1118.         IF D<>0
  1119.           THEN
  1120.             PRINT('   '+CSTR(D)+' with equipment');
  1121.       END;
  1122.       oathtext := '';
  1123.       if (random(3)<>0) then begin
  1124.           makeoath(userr.fa,usert.fa,oathtext);
  1125.           print(oathtext);
  1126.       end;
  1127.       addmsg(userr.fa+' DESTROYED '+usert.fa+' at '+time+' on '+date);
  1128.       if (oathtext <> '') then addmsg(oathtext);
  1129.       sysoplog(time+' '+date+' '+userr.fa+' DESTROYED '+usert.fa+' in Tradewars');
  1130. END;
  1131.  
  1132. BEGIN
  1133.   ANSIC(8);
  1134.   PRINT('<Attack>');
  1135.   READIN(S2,USERT);
  1136.   A := USERT.FI;
  1137.   READIN(A,USERT);
  1138.   if ((s2-lp)=1) AND ((int(d/2.0)*2)=d) then
  1139.     begin
  1140.       printfile('tradewar\nonono.msg');
  1141.       sysoplog(userr.fa+' tried to start a fight in a class 0 port');
  1142.       addmsg(userr.fa+' received an Imperial Warning on '+date+', at '+time);
  1143.     end
  1144.   else
  1145.   IF USERT.FO=0
  1146.     THEN
  1147.       BEGIN
  1148.         ANSIC(8);
  1149.         PRINT('There are no ships here to attack.');
  1150.       END
  1151.     ELSE
  1152.       BEGIN
  1153.         F2 := USERR.FG;
  1154.         LA := A;
  1155.         IF F2<1
  1156.           THEN
  1157.             BEGIN
  1158.               ANSIC(4);
  1159.               PRINT('You don''t have any fighters.');
  1160.             END
  1161.           ELSE
  1162.             BEGIN
  1163.               DONE := FALSE;
  1164.               A := USERT.FO;
  1165.               REPEAT
  1166.                 READIN(A,USERT);
  1167.                 PROMPT('Attack '+USERT.FA+' (Y/N)[N]? ');
  1168.                 IF YN
  1169.                   THEN
  1170.                     BEGIN
  1171.                       P := A;
  1172.                       DONE := TRUE;
  1173.                     END
  1174.                   ELSE
  1175.                     A := USERT.FO;
  1176.               UNTIL DONE OR (A=0) OR HANGUP;
  1177.               IF (NOT DONE) OR HANGUP
  1178.                 THEN
  1179.                   PRINT('There are no other ships in this sector')
  1180.                 ELSE
  1181.                   BEGIN
  1182.                     PROMPT('How many fighters do you wish to use [0]? ');
  1183.                     INPUT(I,4);
  1184.                     N := VALUE(I);
  1185.                     IF (N>=1) AND (N<=9999)
  1186.                       THEN
  1187.                         BEGIN
  1188.                           READIN(P,USERT);
  1189.                           E2 := USERT.FG;    (* enemy fighters on ship *)
  1190.                           E3 := USERT.FE;    (* enemy armor on ship *)
  1191.                           L1 := 0;           (* friendlies lost *)
  1192.                           K1 := 0;           (* enemies lost *)
  1193.                           F2 := USERR.FG;    (* friendlies on board *)
  1194.                           IF N>F2
  1195.                             THEN
  1196.                               BEGIN
  1197.                                 ANSIC(7);
  1198.                                 PRINT('You don''t have that many fighters.');
  1199.                               END
  1200.                             ELSE
  1201.  
  1202.     {  BEGINNING OF COMBAT }
  1203.                               BEGIN
  1204.                                 IF E3 > 0 THEN
  1205.                                 PRINT('Your fighters encounter a powerful force-shield around the enemy ship!');
  1206.                                 REPEAT
  1207.                                   IF RANDOM(2)+1=1
  1208.                                     THEN
  1209.                                       L1 := L1+1
  1210.                                     ELSE
  1211.                                       IF E3>0 THEN
  1212.                                          E3 := E3-1
  1213.                                       ELSE
  1214.                                          K1 := K1+1;
  1215.                                 UNTIL (L1>=N) OR (K1>E2);
  1216.                                 IF (K1>0) OR (E3<usert.fe)
  1217.                                   THEN
  1218.                                     MESSAGE(P,PN,K1,usert.fe-E3);
  1219.                                 READIN(P,USERT);
  1220.                                 USERR.FG := F2-L1;
  1221.                                 USERT.FG := E2-K1;
  1222.                                 USERT.FE := E3;
  1223.                                 WRITEOUT(PN,USERR);
  1224.                                 WRITEOUT(P,USERT);
  1225.                                 NL;
  1226.                                 PRINT('You lost '+CSTR(L1)+' fighter(s), '+CSTR
  1227.                                 (F2-L1)+' remain.');
  1228.  
  1229.                                 if ((userr.fg/2) > usert.fg)
  1230.                                     and ((e2-k1) > 0) then   { RUN AWAY! }
  1231.                                   begin
  1232.                                     dest := 0;
  1233.                                     counter := 0;
  1234.                                     readin(prr+lp,userz);
  1235.                                     boggey := random(6);
  1236.                                     repeat
  1237.                                       boggey := boggey + 1;
  1238.                                       if boggey > 6 then boggey := 1;
  1239.                                       case boggey of
  1240.                                         1 : dest := userz.fb;
  1241.                                         2 : dest := userz.fc;
  1242.                                         3 : dest := userz.fd;
  1243.                                         4 : dest := userz.fe;
  1244.                                         5 : dest := userz.ff;
  1245.                                         6 : dest := userz.fg;
  1246.                                       end;
  1247.                                       counter := counter + 1;
  1248.                                       if  dest > 0 then readin(dest+lp,userd);
  1249.                                       fexit := false;
  1250.                                       if (counter < 12) and (dest > 0) then
  1251.                                         fexit := True;
  1252.                                     until ((dest <> 0)
  1253.                                        and ((userd.fl = 0) or (userd.fm=p)))
  1254.                                        or (counter >= 12);
  1255.                                     if fexit then
  1256.                                     begin
  1257.                                       rship(p);
  1258.                                       readin(p,usery);
  1259.                                       usery.ff := dest;
  1260.                                       usery.fq := prr;
  1261.                                       writeout(p,usery);
  1262.                                       aship(p);
  1263.                                       readin(pn,userr);
  1264.                                       readin(p,usert);
  1265.                                       ansic(3);
  1266.                                       print(Usert.fa+' warps out of the sector!');
  1267.                                       ssm(p,'You fled from '+userr.fa+' to sector '+cstr(dest));
  1268.                                     end
  1269.                                     else
  1270.                                       print(Usert.fa+' tried to warp out of the sector but failed!');
  1271.  
  1272.                                   end;
  1273.  
  1274.                                 IF E2-K1>0 THEN
  1275.                                   BEGIN
  1276.                                     ANSIC(5);
  1277.                                     PRINT('You destroyed '+CSTR(K1)+
  1278.                                     ' enemy fighters,'+CSTR(E2-K1)+' remain.'
  1279.                                     );
  1280.                                   END
  1281.                                 ELSE
  1282.                                   BEGIN
  1283.                                     SALVAGE(PN,P);
  1284.                                     KILLED(PN,P);
  1285.                                   END
  1286.                               END;
  1287.  
  1288.     {  END OF COMBAT }
  1289.  
  1290.                         END;
  1291.                   END;
  1292.             END;
  1293.       END;
  1294. END;
  1295.  
  1296.  
  1297.  
  1298.  
  1299. OVERLAY
  1300.  
  1301. PROCEDURE PLANET;
  1302.  
  1303.  VAR
  1304.      T,L2,L,M : INTEGER;
  1305.      DONE     : BOOLEAN;
  1306.      I        : STR;
  1307.  
  1308.  
  1309. function emptyholds:integer;
  1310. begin
  1311.    emptyholds := userr.fh-userr.fi-userr.fj-userr.fk;
  1312. end;
  1313.  
  1314. overlay PROCEDURE UPPLANET(S2:INTEGER);
  1315.  
  1316.   VAR
  1317.       L,C,L2,MN : INTEGER;
  1318.       DIM       : REAL;
  1319. BEGIN
  1320.   READIN(S2,USERT);
  1321.   IF USERT.FO<>0
  1322.     THEN
  1323.       BEGIN
  1324.         L2 := USERT.FO+LT1;
  1325.         H[0] := USERR.FH;
  1326.         H[1] := USERR.FI;
  1327.         H[2] := USERR.FJ;
  1328.         H[3] := USERR.FK;
  1329.         READIN(L2,USERT);
  1330.         N[1] := USERT.FF+USERT.FI/10000;
  1331.         N[2] := USERT.FG+USERT.FJ/10000;
  1332.         N[3] := USERT.FH+USERT.FK/10000;
  1333.         PUB[1] := USERT.FC;
  1334.         PUB[2] := USERT.FD;
  1335.         PUB[3] := USERT.FE;
  1336.         GETDATE;
  1337.         C := D;
  1338.         MN := VALUE(COPY(TIME,1,2))*60+VALUE(COPY(TIME,4,2));
  1339.         DIM := D-USERT.FB+(MN-USERT.FR)/1440;
  1340.         IF DIM< 0
  1341.           THEN
  1342.             D := 0
  1343.           ELSE
  1344.             IF DIM>10
  1345.               THEN
  1346.                 DIM := 10.0;
  1347.         FOR L:=1 TO 3 DO
  1348.           BEGIN
  1349.             N[L] := N[L]+PUB[L]*DIM;
  1350.             IF N[L]>PUB[L]*40
  1351.               THEN
  1352.                 N[L] := PUB[L]*40;
  1353.           END;
  1354.       END;
  1355.   READIN(L2,USERT);
  1356.   USERT.FB := C;
  1357.   USERT.FF := TRUNC(N[1]);
  1358.   USERT.FG := TRUNC(N[2]);
  1359.   USERT.FH := TRUNC(N[3]);
  1360.   FOR L:=1 TO 3 DO
  1361.     BEGIN
  1362.       SRR[L,0] := INT((N[L]-INT(N[L]))*10000+0.5);
  1363.       N[L] := INT(N[L]);
  1364.     END;
  1365.   USERT.FI := TRUNC(SRR[1,0]);
  1366.   USERT.FJ := TRUNC(SRR[2,0]);
  1367.   USERT.FK := TRUNC(SRR[3,0]);
  1368.   USERT.FR := MN;
  1369.   WRITEOUT(L2,USERT);
  1370. END;
  1371.  
  1372.  
  1373. overlay PROCEDURE TAKEORE(L2:INTEGER);
  1374.  
  1375.   VAR
  1376.       O: INTEGER;
  1377.     amt: integer;
  1378.       I: STR;
  1379. BEGIN
  1380.   ANSIC(2);
  1381.   PRINT('<Take/Leave ore>');
  1382.   if trunc(N[1]) < emptyholds then
  1383.   amt := trunc(N[1]) else amt := emptyholds;
  1384.   PRINT('How much (- to leave) ['+CSTR(amt)+']? ');
  1385.   INPUT(I,3);
  1386.   IF I=''
  1387.     THEN
  1388.       O := amt
  1389.     ELSE
  1390.       O := VALUE(I);
  1391.   IF (O>N[1]) or (n[1]-O>(pub[1]*40))
  1392.     THEN
  1393.       if O>0 then PRINT('They don''t have that many.')
  1394.       else PRINT('They don''t have room for that many.')
  1395.     ELSE
  1396.       IF (H[0]-H[1]-H[2]-H[3]<O) or (-O>H[1])
  1397.         THEN
  1398.           if O>0 then PRINT('You don''t have enough free cargo holds.')
  1399.           else PRINT('You don''t have that many on board.')
  1400.         ELSE
  1401.           BEGIN
  1402.             USERR.FI := USERR.FI+O;
  1403.             WRITEOUT(PN,USERR);
  1404.             READIN(L2,USERT);
  1405.             USERT.FF := USERT.FF-O;
  1406.             WRITEOUT(L2,USERT);
  1407.             H[1] := H[1]+O;
  1408.             N[1] := N[1]-O;
  1409.           END;
  1410. END;
  1411.  
  1412. overlay PROCEDURE TAKEORG(L2:INTEGER);
  1413.  
  1414.   VAR
  1415.       O: INTEGER;
  1416.     amt: integer;
  1417.       I: STR;
  1418. BEGIN
  1419.   ANSIC(3);
  1420.   PRINT('<Take/Leave organics>');
  1421.   if trunc(N[2]) < emptyholds then
  1422.   amt := trunc(N[2]) else amt := emptyholds;
  1423.   PRINT('How much (- to leave) ['+CSTR(amt)+']? ');
  1424.   INPUT(I,3);
  1425.   IF I=''
  1426.     THEN
  1427.       O := amt
  1428.     ELSE
  1429.       O := VALUE(I);
  1430.   IF (O>N[2]) or (n[2]-O>(pub[2]*40))
  1431.     THEN
  1432.       if O>0 then PRINT('They don''t have that many.')
  1433.       else PRINT('They don''t have room for that many.')
  1434.     ELSE
  1435.       IF (H[0]-H[1]-H[2]-H[3]<O) or (-O>H[2])
  1436.         THEN
  1437.           if O>0 then PRINT('You don''t have enough free cargo holds.')
  1438.           else PRINT('You don''t have that many on board.')
  1439.         ELSE
  1440.           BEGIN
  1441.             USERR.FJ := USERR.FJ+O;
  1442.             WRITEOUT(PN,USERR);
  1443.             READIN(L2,USERT);
  1444.             USERT.FG := USERT.FG-O;
  1445.             WRITEOUT(L2,USERT);
  1446.             H[2] := H[2]+O;
  1447.             N[2] := N[2]-O;
  1448.           END;
  1449. END;
  1450.  
  1451. overlay PROCEDURE TAKEEQU(L2:INTEGER);
  1452.  
  1453.   VAR
  1454.       O: INTEGER;
  1455.     amt: integer;
  1456.       I: STR;
  1457. BEGIN
  1458.   ANSIC(4);
  1459.   PRINT('<Take/Leave equipment>');
  1460.   if trunc(N[3]) < emptyholds then
  1461.   amt := trunc(N[3]) else amt := emptyholds;
  1462.   PRINT('How much (- to leave) ['+CSTR(amt)+']? ');
  1463.   INPUT(I,3);
  1464.   IF I=''
  1465.     THEN
  1466.       O := amt
  1467.     ELSE
  1468.       O := VALUE(I);
  1469.   IF (O>N[3]) or (n[3]-O>(pub[3]*40))
  1470.     THEN
  1471.       if O>0 then PRINT('They don''t have that many.')
  1472.       else PRINT('They don''t have room for that many.')
  1473.     ELSE
  1474.       IF (H[0]-H[1]-H[2]-H[3]<O) or (-O>H[3])
  1475.         THEN
  1476.           if O>0 then PRINT('You don''t have enough free cargo holds.')
  1477.           else PRINT('You don''t have that many on board.')
  1478.         ELSE
  1479.           BEGIN
  1480.             USERR.FK := USERR.FK+O;
  1481.             WRITEOUT(PN,USERR);
  1482.             READIN(L2,USERT);
  1483.             USERT.FH := USERT.FH-O;
  1484.             WRITEOUT(L2,USERT);
  1485.             H[3] := H[3]+O;
  1486.             N[3] := N[3]-O;
  1487.           END;
  1488. END;
  1489.  
  1490. PROCEDURE TAKEALL(L2:INTEGER);
  1491.  
  1492.   VAR
  1493.       F,A: INTEGER;
  1494. BEGIN
  1495.   ANSIC(5);
  1496.   PRINT('<Take all>');
  1497.   F := TRUNC(H[0]-H[1]-H[2]-H[3]);
  1498.   A := TRUNC(N[3]);
  1499.   IF F=0
  1500.     THEN
  1501.       BEGIN
  1502.         ANSIC(8);
  1503.            PRINT('You don''t have any free holds.');
  1504.       END
  1505.     ELSE
  1506.       BEGIN
  1507.         sysoplog(userr.fa+' depleted planet '+usert.fa);
  1508.         IF F<A
  1509.           THEN
  1510.             A := F;
  1511.         IF F<>0
  1512.           THEN
  1513.             BEGIN
  1514.               F := F-A;
  1515.               H[3] := H[3]+A;
  1516.               N[3] := N[3]-A;
  1517.               USERR.FK := USERR.FK+A;
  1518.               WRITEOUT(PN,USERR);
  1519.               READIN(L2,USERT);
  1520.               USERT.FH := USERT.FH-A;
  1521.               WRITEOUT(L2,USERT);
  1522.               PRINT('You took '+CSTR(A)+' holds of equipment.');
  1523.               A := TRUNC(N[2]);
  1524.               IF F=0
  1525.                 THEN
  1526.                   BEGIN
  1527.                     ANSIC(5);
  1528.                     PRINT('Your holds are filled.');
  1529.                   END
  1530.                 ELSE
  1531.                   BEGIN
  1532.                     IF F<A
  1533.                       THEN
  1534.                         A := F;
  1535.                     IF F<>0
  1536.                       THEN
  1537.                         BEGIN
  1538.                           F := F-A;
  1539.                           H[2] := H[2]+A;
  1540.                           N[2] := N[2]-A;
  1541.                           USERR.FJ := USERR.FJ+A;
  1542.                           WRITEOUT(PN,USERR);
  1543.                           READIN(L2,USERT);
  1544.                           USERT.FG := USERT.FG-A;
  1545.                           WRITEOUT(L2,USERT);
  1546.                           PRINT('You took '+CSTR(A)+' holds of organics.');
  1547.                           A := TRUNC(N[1]);
  1548.                           IF F=0
  1549.                             THEN
  1550.                               BEGIN
  1551.                                 ANSIC(5);
  1552.                                 PRINT('Your cargo holds are filled.');
  1553.                               END
  1554.                             ELSE
  1555.                               BEGIN
  1556.                                 IF F<A
  1557.                                   THEN
  1558.                                     A := F;
  1559.                                 IF F<>0
  1560.                                   THEN
  1561.                                     BEGIN
  1562.                                       F := F-A;
  1563.                                       H[1] := H[1]+A;
  1564.                                       N[1] := N[1]-A;
  1565.                                       USERR.FI := USERR.FI+A;
  1566.                                       WRITEOUT(PN,USERR);
  1567.                                       READIN(L2,USERT);
  1568.                                       USERT.FF := USERT.FF-A;
  1569.                                       WRITEOUT(L2,USERT);
  1570.                                       PRINT('You took '+CSTR(A)+
  1571.                                       ' holds of ore.');
  1572.                                     END;
  1573.                               END;
  1574.                         END;
  1575.                   END;
  1576.             END;
  1577.       END;
  1578. END;
  1579.  
  1580. overlay PROCEDURE INCREASE(L2:INTEGER);
  1581.  
  1582.   VAR
  1583.       A1   : INTEGER;
  1584.       B1   : REAL;
  1585. BEGIN
  1586.   ANSIC(8);
  1587.   PRINT('<Increase productivity>');
  1588.   NL;
  1589.   ANSIC(4);
  1590.   PRINT('You have '+CSTRR(USERR.credits,10)+' credits.');
  1591.   NL;
  1592.   PRINT('1 - Ore, now at '+cstrr(pub[1],10)+
  1593.         '/day, costs '+cstrr(pub[1]*(b[1]*2),10));
  1594.   ANSIC(2);
  1595.   PRINT('2 - Organics, now at '+cstrr(pub[2],10)+
  1596.         '/day, costs '+cstrr(pub[2]*(b[2]*2),10));
  1597.   ANSIC(3);
  1598.   PRINT('3 - Equipment, now at '+cstrr(pub[3],10)+
  1599.         '/day, costs '+cstrr(pub[3]*(b[3]*2),10));
  1600.   ANSIC(5);
  1601.   PROMPT('Which one do you want to increase (1,2,3)? [Q to quit] ');
  1602.   MMKEY(I);
  1603.   IF pos(I,'123') > 0 THEN BEGIN
  1604.     A := VALUE(I);
  1605.     B1 := USERR.credits;
  1606.     IF (pub[A]*(b[A]*2))>B1 THEN PRINT('You''re too poor.  You only have '+CSTRR(USERR.credits,10)+' credits.')
  1607.     ELSE BEGIN
  1608.       USERR.credits := B1-trunc(pub[A]*(b[A]*2));
  1609.       print(cstrr((b1-userr.credits),10)+' deducted from your account.');
  1610.       WRITEOUT(PN,USERR);
  1611.       READIN(L2,USERT);
  1612.       case A of
  1613.         1 : USERT.FC := USERT.FC+1;
  1614.         2 : USERT.FD := USERT.FD+1;
  1615.         3 : USERT.FE := USERT.FE+1;
  1616.       end;
  1617.       WRITEOUT(L2,USERT);
  1618.       pub[A] := pub[A]+1;
  1619.     END;
  1620.   END;
  1621. END;
  1622.  
  1623.  
  1624. PROCEDURE DESTROY(L2:INTEGER);
  1625. BEGIN
  1626.   IF PRR<>1 THEN
  1627.   BEGIN
  1628.      NL;
  1629.      ANSIC(8);
  1630.      PRINT('*** DESTROY THE PLANET ***');
  1631.      ANSIC(1);
  1632.      NL;
  1633.      PROMPT('Confirmed??? (Y/N)[N]? ');
  1634.      IF YN
  1635.        THEN
  1636.        begin
  1637.        PROMPT('Are you absolutely sure??? (Y/N)[N]? ');
  1638.        IF YN THEN
  1639.          IF userr.fg >=50 THEN
  1640.          BEGIN
  1641.            READIN(L2,USERT);
  1642.            USERT.FM := 0;
  1643.            WRITEOUT(L2,USERT);
  1644.            READIN(S2,USERT);
  1645.            USERT.FO := 0;
  1646.            WRITEOUT(S2,USERT);
  1647.            addmsg(userr.fa+' destroyed the planet in sector '+
  1648.                   cstr(s2-lp)+' at '+time+' on '+date);
  1649.            addmsg('  ...causing the deaths of countless millions...');
  1650.            addmsg('*NOTE  The Federation has placed a 10,000 credit bounty on '+userr.fa);
  1651.            ssm(pn,'The Federation has sent this message:');
  1652.            ssm(pn,'     Destroy another planet and we will send');
  1653.            ssm(pn,'     the War Rocket Ajax to bring back your body!');
  1654.            userr.fc := -75;
  1655.            writeout(pn,userr);
  1656.            SYSOPLOG('  -  '+USERR.FA+' destroyed the planet in sector'+cstr(s2-lp));
  1657.            ANSIC(3);
  1658.            NL;
  1659.            PRINTFILE('tradewar\geneboom.msg');
  1660.            DONE := TRUE;
  1661.            userr.fg := userr.fg - 30;
  1662.            writeout(PN,userr);
  1663.            ANSIC(1);
  1664.          END
  1665.          ELSE
  1666.          BEGIN
  1667.             ANSIC(4);
  1668.             PRINT('Your computer has forcasted a loss of 25-40 K3-A fighters and');
  1669.             ANSIC(4);
  1670.             PRINT('has aborted the mission.');
  1671.             DONE := TRUE;
  1672.          END;
  1673.       end;
  1674.      END
  1675.    ELSE
  1676.    begin
  1677.        addmsg(userr.fa+' TRIED TO DESTROY EARTH!!!! at '+time+' on '+date);
  1678.        sysoplog(' !!!!!  '+userr.fareal+' Tried to destroy Earth at '+time+' on '+date);
  1679.        userr.fb := userr.fb + 7;
  1680.        writeout(PN,userr);
  1681.        PRINTFILE('tradewar\terrkill.msg');
  1682.        killed(pn,pn);
  1683.        ended := TRUE;
  1684.        done := TRUE;
  1685.    end;
  1686. END;
  1687.  
  1688.  
  1689.  
  1690. PROCEDURE DISPLAY;
  1691.  
  1692.   VAR
  1693.       I : INTEGER;
  1694. BEGIN
  1695.   UPPLANET(S2);
  1696.   NL;
  1697.   READIN(L2,USERT);
  1698.   ANSIC(5);
  1699.   PRINT('Planet: '+USERT.FA);
  1700.   nl;
  1701.   ansic(7);
  1702.   print('Created by: '+usert.fareal);
  1703.   nl;
  1704.   ANSIC(3);
  1705.   PRINT(' Item      Prod.  Amount  in holds');
  1706.   ANSIC(2);
  1707.   PRINT(' ~~~~      ~~~~~  ~~~~~~  ~~~~~~~~');
  1708.   ANSIC(6);
  1709.   FOR I:=1 TO 3 DO
  1710.     BEGIN
  1711.       ANSIC(4+I);
  1712.       PROMPT(P[I]);
  1713.       PROMPT(ADDBLANK(CSTR(TRUNC(PUB[I])),5));
  1714.       PROMPT(ADDBLANK(CSTR(TRUNC(N[I])),7));
  1715.       PRINT(ADDBLANK(CSTR(TRUNC(H[I])),8));
  1716.     END;
  1717.   nl;
  1718.   ansic(3);
  1719.   PRINT('You have '+CSTR(TRUNC(H[0]-H[1]-H[2]-H[3]))+
  1720.         ' free cargo holds.');
  1721.   nl;
  1722. END;
  1723.  
  1724. BEGIN
  1725.   cls;
  1726.   PRINT('<Land on planet surface>');
  1727.   NL;
  1728.   PRINT('Landing...');
  1729.   PRR := USERR.FF;
  1730.   S2 := PRR+LP;
  1731.   PD := USERR.FB;
  1732.   READIN(S2,USERT);
  1733.   L := USERT.FO;
  1734.   IF L=0
  1735.     THEN
  1736.       BEGIN
  1737.         ANSIC(4);
  1738.         PRINT('There isn''t a planet in this sector.');
  1739.         PRINT('You can create one with a Genesis Torpedo.');
  1740.         PRINT('Torpedoes cost 10,000 credits.');
  1741.         ANSIC(1);
  1742.         IF USERR.credits < 10000
  1743.           THEN
  1744.             BEGIN
  1745.               PRINT('You''re too poor to buy one.');
  1746.             END
  1747.           ELSE
  1748.             BEGIN
  1749.               NL;
  1750.               PRINT('You have '+CSTRR(USERR.credits,10)+' credits.');
  1751.               PROMPT('Do you wish to buy a torpedo (Y/N) [N]? ');
  1752.               IF YN
  1753.                 THEN
  1754.                   BEGIN
  1755.                     DONE := FALSE;
  1756.                     L := LT1+1;
  1757.                     REPEAT
  1758.                       READIN(L,USERT);
  1759.                       IF USERT.FM=0
  1760.                         THEN
  1761.                           DONE := TRUE;
  1762.                       L := L+1;
  1763.                     UNTIL DONE OR (L>LL1);
  1764.                     L := L-1;
  1765.                     IF NOT DONE
  1766.                       THEN
  1767.                         BEGIN
  1768.                           NL;
  1769.                           PRINT(
  1770.                               'I''m  sorry, but not enough free matter exists.'
  1771.                           );
  1772.                           PRINT(
  1773.                            'One has to be destroyed before you can create one.'
  1774.                           );
  1775.                         END
  1776.                       ELSE
  1777.                         BEGIN
  1778.                           ANSIC(2);
  1779.                           PRINTFILE('tradewar\genesis.msg');
  1780.                           ANSIC(1);
  1781.                           PROMPT(
  1782.                       'What do you want to name this planet? (41 chars. max)? '
  1783.                           );
  1784.                           INPUTL(I,41);
  1785.                           READIN(L,USERT);
  1786.                           USERT.FA := I;
  1787.                           usert.fareal := userr.fa;
  1788.                           USERT.FM := LENGTH(I);
  1789.                           USERT.FC := 1;
  1790.                           USERT.FD := 1;
  1791.                           USERT.FE := 1;
  1792.                           USERT.FF := 1;
  1793.                           USERT.FG := 1;
  1794.                           USERT.FH := 1;
  1795.                           USERT.FI := 0;
  1796.                           USERT.FJ := 0;
  1797.                           USERT.FK := 0;
  1798.                           WRITEOUT(L,USERT);
  1799.                           READIN(S2,USERT);
  1800.                           USERT.FO := L-LT1;
  1801.                           WRITEOUT(S2,USERT);
  1802.                           GETDATE;
  1803.                           M := VALUE(COPY(TIME,1,2))*60+VALUE(COPY(TIME,4,2));
  1804.                           READIN(L,USERT);
  1805.                           USERT.FB := D;
  1806.                           USERT.FR := M;
  1807.                           WRITEOUT(L,USERT);
  1808.                           USERR.credits := USERR.credits-10000;
  1809.                           WRITEOUT(PN,USERR);
  1810.                           SYSOPLOG('  -  '+USERR.FA+' made a planet: '+I);
  1811.                           NL;
  1812.                         END
  1813.                   END
  1814.             END
  1815.       END
  1816.     ELSE
  1817.       BEGIN
  1818.         L2 := L+LT1;
  1819.         DISPLAY;
  1820.         DONE := FALSE;
  1821.         REPEAT
  1822.           PROMPT('Planet command (?=help) [?] ');
  1823.           MMKEY(I);
  1824.           IF I=''
  1825.             THEN
  1826.               I := 'A';
  1827.           CASE I[1] OF
  1828.             '1' : TAKEORE(L2);
  1829.             '2' : TAKEORG(L2);
  1830.             '3' : TAKEEQU(L2);
  1831.             'R' : DISPLAY;
  1832.             'L' : DONE := TRUE;
  1833.             'A' : TAKEALL(L2);
  1834.             'I' : INCREASE(L2);
  1835.             'D' : DESTROY(L2);
  1836.           else printfile('tradewar\planhelp.msg');
  1837.           END;
  1838.         UNTIL DONE OR HANGUP;
  1839.         NL;
  1840.         ANSIC(5);
  1841.         PRINT('leaving Planet...');
  1842.         ANSIC(1);
  1843.       END;
  1844. END;
  1845.  
  1846. OVERLAY
  1847.  
  1848. PROCEDURE STARTING;
  1849. BEGIN
  1850.   IF (USERR.FF<1) AND (NOT ENDED)
  1851.     THEN
  1852.       BEGIN
  1853.         PRINT('You are being moved to sector 1');
  1854.         USERR.FF := 1;
  1855.         USERR.FQ := 0;
  1856.         WRITEOUT(PN,USERR);
  1857.       END;
  1858.   IF USERR.credits>25000
  1859.     THEN
  1860.       BEGIN
  1861.         NL;
  1862.         ANSIC(8);
  1863.         PRINT('Tax time!  You are being taxed 3000 credits to help '+
  1864.               'support the struggle against the Ferrengi');
  1865.         ANSIC(1);
  1866.         USERR.credits := USERR.credits-3000;
  1867.         WRITEOUT(PN,USERR);
  1868.       END;
  1869.   ENTERROOM;
  1870. END;
  1871.  
  1872.  
  1873. overlay procedure setautopilot;
  1874.  
  1875. var
  1876.    done     : boolean;
  1877.    l        : integer;
  1878.    flip     : str;
  1879.  
  1880. begin
  1881.    asd := userr.ff;
  1882.    done := FALSE;
  1883.    flip := ' ';
  1884.    cls;
  1885.    ansic(6);
  1886.    print('<Auto Pilot Engaging>');
  1887.    while (flip<>'G') and (not hangup) do
  1888.    begin
  1889.      nl;
  1890.      ansic(2);
  1891.      if players then print('<A> Stop when encountering another Trader')
  1892.                 else print('<A> Ignore other Traders');
  1893.      ansic(4);
  1894.      if ports   then print('<B> Stop when encountering a Space Port')
  1895.                 else print('<B> Ignore Space Ports');
  1896.      ansic(5);
  1897.      if planets then print('<C> Stop when encountering a Planet')
  1898.                 else print('<C> Ignore Planets');
  1899.      nl;
  1900.      ansic(7);
  1901.      prompt('Enter letter of option to flip or <CR> to continue. ');
  1902.      input(flip,1);
  1903.      if flip = '' then flip := 'G';
  1904.      case flip of
  1905.          'A' : players := not players;
  1906.          'B' : ports   := not ports;
  1907.          'C' : planets := not planets;
  1908.      end;
  1909.    end;
  1910.    for l := 1 to 6 do
  1911.       if (e[l]=s[asd,1]) then done := true;
  1912.    if not (done) or (s[asd,1]=0) then
  1913.      begin
  1914.         nl;
  1915.         ansic(2);
  1916.         Print('To engage AutoPilot, you must first chart your course using the');
  1917.         ansic(2);
  1918.         print('sector finder of your on-board computer...');
  1919.         nl;
  1920.      end
  1921.    else
  1922.      begin
  1923.        autop := TRUE;
  1924.        drop := FALSE;
  1925.        while not ((drop) or (hangup) or (s[asd,1]=0)) do
  1926.        begin
  1927.           nl;
  1928.           print('Auto Warping to sector '+cstr(s[asd,1]));
  1929.           moveit;
  1930.           readin(pn,userr);
  1931.           asd := userr.ff;
  1932.        end;
  1933.        autop := FALSE;
  1934.      end;
  1935. end;
  1936.  
  1937.  
  1938.  
  1939.  
  1940. OVERLAY PROCEDURE MINEDROP;
  1941.  
  1942. BEGIN
  1943.    readin(PN,userr);
  1944.    ANSIC(6);
  1945.    PROMPT('Do you really want to drop a mine in this sector? ');
  1946.    IF YN THEN
  1947.       BEGIN
  1948.          NL;
  1949.          IF USERR.FF>9 THEN           (* Outside sector 9 *)
  1950.             BEGIN
  1951.             IF (USERR.FH<2) OR (USERR.FG<6) THEN
  1952.                PRINT('You don''t have enough resources aboard to build a mine.')
  1953.             ELSE
  1954.             BEGIN
  1955.                PRINTFILE('tradewar\twmine.msg');
  1956.                sysoplog(userr.fa+' dropped a mine in sector '+cstr(userr.ff));
  1957.                addmsg(userr.fa+' built a mine somewhere! ');
  1958.                userr.fg := userr.fg-5;  (* use 5 fighters *)
  1959.                userr.fh := userr.fh-2;  (* use 2 holds    *)
  1960.                IF userr.fh < (userr.fi+userr.fj+userr.fk) THEN
  1961.                  IF userr.fk > 1 THEN
  1962.                     userr.fk := userr.fk - 2
  1963.                  ELSE
  1964.                    IF userr.fj > 1 THEN
  1965.                       userr.fj := userr.fj - 2
  1966.                    ELSE
  1967.                      IF userr.fi > 1 THEN
  1968.                         userr.fi := userr.fi - 2;
  1969.                writeout(pn,userr);
  1970.                readin(userr.ff+LP,usert);
  1971.                usert.fp := usert.fp + 1;
  1972.                IF usert.fp > 20 THEN usert.fp := 20;
  1973.                writeout(userr.ff+LP,usert);
  1974.               END;
  1975.             END
  1976.          ELSE
  1977.             BEGIN
  1978.                PRINT('The Federation does not like people mining the home quadrant...');
  1979.             END;
  1980.       END;
  1981. END;
  1982.  
  1983.